acsi_analysis.Rmd

ACSI Backtesting Analysis

What is the relationship between the American Consumer Satisfaction Index (ACSI) scores and stock prices? What about across sectors?

score_data.csv - ACSI scores for a company for a given year stock_data.csv - Stock price data for companies (starting on the first day of the year)

— Preparation —

Load Libraries / Set Options

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0      ✔ purrr   0.3.5 
## ✔ tibble  3.1.8      ✔ dplyr   1.0.10
## ✔ tidyr   1.2.1      ✔ stringr 1.5.0 
## ✔ readr   2.1.3      ✔ forcats 0.5.2 
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## 
## Attaching package: 'magrittr'
## 
## 
## The following object is masked from 'package:purrr':
## 
##     set_names
## 
## 
## The following object is masked from 'package:tidyr':
## 
##     extract
## 
## 
## 
## Attaching package: 'gridExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     combine
## 
## 
## 
## Attaching package: 'kableExtra'
## 
## 
## The following object is masked from 'package:dplyr':
## 
##     group_rows

Load Data

Load the ACSI score data

score_data <- read_csv("score_data.csv")

kable(score_data) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE) %>%
  column_spec(2, bold = TRUE)

…1	company_name	sector	publicly_traded	ticker	1995	1996	1997	1998	1999	2000	2001	2002	2003	2004	2005	2006	2007	2008	2009	2010	2011	2012	2013	2014	2015	2016	2017	2018	2019	2020
0	FedEx	Consumer Shipping	Yes	FDX	85	86	82	80	83	83	82	82	82	83	84	86	84	85	84	85	83	82	85	82	82	82	82	81	79	80
1	Atmos Energy	Investor-Owned Energy Utilities	Yes	ATO	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	78	78	81	83	85	83	82	77	80	80	78	78
3	CenterPoint Energy	Investor-Owned Energy Utilities	Yes	CNP	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	72	74	75	78	78	80	82	84	81	81	76	79	82	80	77
4	UPS	Consumer Shipping	Yes	UPS	83	87	82	77	79	81	78	80	79	80	82	83	81	83	82	82	85	81	84	82	82	80	81	82	79	76
5	NextEra Energy	Investor-Owned Energy Utilities	Yes	NEE	77	74	69	75	74	76	73	71	73	76	74	68	73	76	76	75	78	80	80	76	77	76	75	76	77	76
6	Consolidated Edison	Investor-Owned Energy Utilities	Yes	ED	76	74	71	69	73	71	66	74	72	68	68	68	69	66	66	66	72	71	70	69	68	71	79	78	78	75
7	Sempra Energy	Investor-Owned Energy Utilities	Yes	SRE	NA	NA	NA	NA	NA	NA	67	74	77	77	79	75	80	80	80	83	81	83	80	82	79	75	78	77	75	75
8	NiSource	Investor-Owned Energy Utilities	Yes	NI	NA	NA	NA	NA	NA	NA	67	68	66	68	68	66	72	70	71	76	76	81	81	78	78	73	78	78	76	75
9	Southern Company	Investor-Owned Energy Utilities	Yes	SO	78	76	77	79	78	80	80	81	82	81	79	80	82	81	78	78	77	81	83	80	77	76	77	79	77	75
10	Dominion Energy	Investor-Owned Energy Utilities	Yes	D	75	72	74	75	74	75	65	70	72	67	71	70	73	75	72	75	77	80	82	80	78	74	77	78	76	74
11	WEC Energy	Investor-Owned Energy Utilities	Yes	WEC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	75	75	76	74
14	Edison International	Investor-Owned Energy Utilities	Yes	EIX	74	77	78	75	73	78	60	66	69	71	75	78	74	75	77	75	75	76	77	77	76	74	76	76	75	74
15	Xcel Energy	Investor-Owned Energy Utilities	Yes	XEL	NA	NA	NA	NA	NA	NA	65	74	73	70	68	70	71	73	76	72	74	74	76	75	76	71	73	73	74	73
16	CMS Energy	Investor-Owned Energy Utilities	Yes	CMS	76	77	75	73	76	76	75	76	78	71	74	72	73	74	70	75	77	75	79	78	76	71	74	75	73	73
17	Ameren	Investor-Owned Energy Utilities	Yes	AEE	NA	NA	NA	NA	NA	NA	78	76	77	74	75	74	57	64	68	71	71	78	74	76	76	72	74	76	75	73
18	PPL	Investor-Owned Energy Utilities	Yes	PPL	NA	NA	NA	NA	NA	NA	80	80	80	79	80	81	81	78	79	74	79	80	80	79	78	75	77	78	73	73
22	Exelon	Investor-Owned Energy Utilities	Yes	EXC							66	69	71	71	71	70	68	69	70	72	73	70	74	75	69	70	71	72	73	72
23	Entergy	Investor-Owned Energy Utilities	Yes	ETR	76	75	70	70	69	74	69	74	71	73	75	70	73	74	74	73	76	78	81	76	77	70	74	75	75	72
24	Public Service Enterprise Group	Investor-Owned Energy Utilities	Yes	PEG	80	77	75	74	73	78	75	76	76	73	74	75	73	75	76	78	78	77	74	70	72	68	72	72	72	72
25	DTE Energy	Investor-Owned Energy Utilities	Yes	DTE	78	78	75	74	74	75	74	68	72	71	68	65	70	72	71	72	73	72	78	80	74	72	73	73	72	72
26	Duke Energy	Investor-Owned Energy Utilities	Yes	DUK	80	83	79	78	80	79	79	79	77	78	78	80	79	76	77	76	77	79	75	77	72	70	73	73	70	71
27	FirstEnergy	Investor-Owned Energy Utilities	Yes	FE	NA	NA	NA	NA	NA	NA	72	77	76	69	71	75	76	77	74	75	78	76	75	73	79	69	73	73	72	71
28	National Grid	Investor-Owned Energy Utilities	Yes	NGG								73	75	69	72	65	71	71	71	70	NM	NM	NM	NM	NM	71	71	73	71	70
29	Eversource Energy	Investor-Owned Energy Utilities	Yes	ES	70	72	67	65	68	72	76	72	73	68	74	72	69	68	72	74	75	59	73	71	66	65	71	70	68	69
30	American Electric Power	Investor-Owned Energy Utilities	Yes	AEP	80	82	77	78	77	79	76	75	74	75	74	75	73	76	74	73	72	79	75	77	74	70	72	73	68	68
31	PG&E	Investor-Owned Energy Utilities	Yes	PCG	71	72	71	68	71	73	49	58	66	66	67	68	72	70	73	70	67	69	74	70	71	72	74	70	70	63
32	Pepco Holdings	Investor-Owned Energy Utilities	Yes	POM	NA	NA	NA	NA	NA	NA	NA	NA	77	72	73	71	70	69	68	70	54	69	71	73	72	69	NA
42	Iberdrola	Investor-Owned Energy Utilities	Yes	IBE	NA	NA	NA	NA	NA	NA	73	73	71	70	73	74	70	75	73	72	NA	NA	NA	NA	NA	NA	NA	NA
47	Unilever	Personal Care and Cleaning Products	Yes	UL	83	83	82	83	81	85	83	83	85	85	85	85	86	87	87	87	82	86	85	80	80	84	81	82	80	NA
48	Optimum (Altice USA)	Internet Service Providers/Fixed-Line Phone	Yes	ATUS								NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	61	69	68	64	63	NA
50	Optimum (Altice USA)	Fixed-Line Telephone Service	Yes	ATUS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	67	72	71	69	69	NA
51	Windstream	Fixed-Line Telephone Service	Yes	WINMQ	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	61	65	65	64	64	NA
53	Vonage	Fixed-Line Telephone Service	Yes	VG	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	78	80	76	77	NA
55	Spirit	Airlines	Yes	SAVE	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	54	62	61	62	63	NA
56	Allegiant	Airlines	Yes	ALGT	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	65	65	71	74	71	NA
57	Alaska	Airlines	Yes	ALK	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	77	78	79	80	NA
59	Mediacom	Internet Service Providers	Yes	MCCC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	57	57	58	53	56	NA
61	Mitsubishi Electric & Electronics	Televisions and Video Players	Yes	6503.T	82	83	81	83	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
62	Allstate	Property and Casualty Insurance	Yes	ALL	73	74	71	73	73	75	76	74	73	76	76	78	78	79	79	78	78	79	77	77	73	77	78	78	78	NA
65	Progressive	Property and Casualty Insurance	Yes	PGR	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	75	73	79	79	80	79	79	81	78	76	74	77	78	78	78	NA
67	Expedia	Internet Travel Services	Yes	EXPE								80	78	76	79	78	75	77	79	79	77	76	NA	76	77	77	80	78	79	NA
68	Mediacom	Subscription Television Service	Yes	MCCC				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	51	54	56	55	56	NA
69	Suddenlink (Altice USA)	Subscription Television Service	Yes	ATUS				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	57	62	63	58	55	NA
72	Frontier	Airlines	Yes	ULCC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	58	66	63	62	64	NA
73	La Quinta (Wyndham)	Hotels	Yes	LQ	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	75	75	76	74	NA
74	PetSmart	Specialty Retail Stores	Yes	PETM				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	77	78	79	79	78	NA
76	Bed Bath & Beyond	Specialty Retail Stores	Yes	BBBY				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	75	79	80	79	80	NA
77	Walmart	Health and Personal Care Stores	Yes	WMT				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	68	68	76	75	73	74	NA
78	Target	Health and Personal Care Stores	Yes	TGT		NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	80	79	NA			NA
79	Kroger	Health and Personal Care Stores	Yes	KR		NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	81	81	80	81	78	NA
81	Dollar Tree	Department and Discount Stores	Yes	DLTR	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	76	80	77	77	77	NA
82	Audi (Volkswagen)	Automobiles and Light Vehicles	Yes	AUDVF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	83	82	83	82	NA
83	Domino’s	Limited-Service Restaurants	Yes	DPZ	70	68	68	70	67	69	73	75	75	NA	71	75	75	75	77	77	77	77	81	80	75	78	78	79	79	NA
86	Big Lots	Department and Discount Stores	Yes	BIG				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	74	77	74	75	73	NA
88	Target	Supermarkets	Yes	TGT	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	71	78	79	78	79	NA
96	Texas Roadhouse	Full-Service Restaurants	Yes	TXRH				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	82	82	83	83	NA
97	GameStop	Specialty Retail Stores	Yes	GME				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	80	77	74	75	NA
98	Priceline	Internet Travel Services	Yes	PCLN						66	69	71	71	73	72	72	73	72	76	73	76	74	NA	75	75	81	77	78	76	NA
99	CBS Broadcasting	Network/Cable TV News	Yes	CBS	75	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
100	Google	Internet Search Engines and Information	Yes	GOOGL					NA	NA	NA	80	82	82	82	81	78	86	86	80	83	82	77	83	78	84	82	82	79	NA
103	BMW	Automobiles and Light Vehicles	Yes	BMWYY	81	81	80	86	86	84	86	86	85	84	86	85	86	87	87	86	83	86	82	80	82	85	82	82	82	NA
104	Cadillac (GM)	Automobiles and Light Vehicles	Yes	GM	84	88	84	88	85	86	88	86	87	83	86	84	86	85	89	86	87	86	85	80	80	79	83	82	81	NA
105	Chevrolet (GM)	Automobiles and Light Vehicles	Yes	GM	79	79	78	79	76	80	78	78	79	77	78	81	82	79	83	80	82	84	79	82	79	83	81	79	80	NA
108	Ford	Automobiles and Light Vehicles	Yes	F	79	78	77	77	77	77	78	78	80	76	75	77	80	80	83	82	84	83	83	81	79	81	79	77	77	NA
109	GMC (GM)	Automobiles and Light Vehicles	Yes	GM	NA	NA	80	78	81	81	79	81	83	80	81	82	82	83	82	84	83	80	85	82	78	84	84	80	78	NA
110	Honda	Automobiles and Light Vehicles	Yes	HMC	86	83	82	81	83	82	83	82	82	85	86	86	84	86	88	84	85	83	86	83	80	86	81	83	82	NA
116	Sprint	Wireless Telephone Service	Yes	S										59	63	63	61	56	63	70	72	71	71	68	65	70	73	70	69	NA
117	Motorola (Lenovo)	Cellular Telephones	Yes	LNVGY										70	70	71	72	74	72	76	77	73	77	77	79	77	76	79	80	NA
118	BlackBerry	Cellular Telephones	Yes	BB										NA	NA	NA	NA	NA	NA	NA	NA	69	69	74	78	NA	NA	NA	NA	NA
123	NYTimes.com	Internet News and Opinion	Yes	NYT								71	70	72	72	72	73	75	73	76	73	74	74	73	76	76	73	75	76	NA
125	Hyundai	Automobiles and Light Vehicles	Yes	HYMTF	68	69	68	72	68	76	81	78	81	81	84	84	83	83	85	82	83	85	82	81	81	81	83	80	79	NA
126	Jeep (Fiat Chrysler)	Automobiles and Light Vehicles	Yes	FCAU	77	76	74	77	77	75	76	79	79	77	78	77	75	76	79	77	79	83	80	79	75	78	80	80	76	NA
127	Kia	Automobiles and Light Vehicles	Yes	KIMTF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	80	81	80	81	82	82	82	78	79	82	79	76	NA
131	Buick (GM)	Automobiles and Light Vehicles	Yes	GM	84	84	83	84	86	86	86	86	84	83	84	86	86	85	88	88	85	87	82	83	80	79	80	80	79	NA
133	Sony	Televisions and Video Players	Yes	SNE	84	81	81	82	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
136	Clorox	Personal Care and Cleaning Products	Yes	CLX	88	84	83	85	84	85	85	85	86	88	88	86	87	87	88	86	88	87	85	85	82	84	84	85	82	NA
137	Colgate-Palmolive	Personal Care and Cleaning Products	Yes	CL	86	82	83	82	80	80	85	80	83	82	83	84	81	87	83	85	84	83	85	83	79	83	81	82	82	NA
138	Henkel	Personal Care and Cleaning Products	Yes	HENKY	85	85	83	81	79	85	84	84	85	85	83	83	86	85	84	83	84	83	84	81	79	85	83	82	77	NA
140	Emerson Electric	Televisions and Video Players	Yes	EMR	81	80	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
141	Volvo	Automobiles and Light Vehicles	Yes	VOLV-B	84	84	84	81	80	82	81	82	81	80	81	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	NA	82	85	82	NA
142	Lexus (Toyota)	Automobiles and Light Vehicles	Yes	TM	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	86	87	87	89	85	87	89	87	84	84	84	86	85	84	NA
143	Lincoln (Ford)	Automobiles and Light Vehicles	Yes	F	84	80	81	83	82	85	82	84	81	86	83	83	86	83	88	89	86	90	NA	NA	83	87	83	84	82	NA
144	Mazda	Automobiles and Light Vehicles	Yes	MZDAY	77	75	74	77	76	78	78	81	82	78	80	79	78	80	81	80	79	82	82	80	80	80	82	80	77	NA
145	Mercedes-Benz	Automobiles and Light Vehicles	Yes	DDAIF	86	87	87	86	86	87	86	83	83	80	80	82	83	82	86	86	86	85	88	86	83	81	84	82	83	NA
146	Nissan	Automobiles and Light Vehicles	Yes	NSANY	82	80	79	77	79	78	80	80	79	81	78	82	80	82	78	82	84	83	83	81	77	80	80	80	75	NA
150	Subaru	Automobiles and Light Vehicles	Yes	FUJHY	79	83	79	83	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	87	86	85	82	84	85	84	82	NA
151	Toyota	Automobiles and Light Vehicles	Yes	TM	84	84	84	85	83	82	83	83	85	84	87	87	84	86	86	84	87	85	86	83	82	85	86	83	81	NA
152	Volkswagen	Automobiles and Light Vehicles	Yes	VOW3	76	76	79	78	82	83	81	82	76	80	78	78	80	81	86	81	84	85	84	84	80	78	79	82	77	NA
153	HuffPost (Verizon)	Internet News and Opinion	Yes	VZ								NA	NA	NA	NA	NA	NA	NA	NA	NA	69	69	69	70	71	72	67	70	70	NA
158	DISH Network	Video-on-Demand Service	Yes	DISH	NA	NA																						73	71	NA
160	DIRECTV (AT&T)	Video-on-Demand Service	Yes	T	NA	NA																						70	70	NA
163	Xfinity (Comcast)	Video-on-Demand Service	Yes	CMCSA	NA	NA																						67	66	NA
164	Spectrum (Charter)	Video-on-Demand Service	Yes	CHTR	NA	NA																						64	64	NA
165	Netflix	Video Streaming Service	Yes	NFLX	NA	NA																						78	79	NA
167	Twitch (Amazon)	Video Streaming Service	Yes	AMZN	NA	NA																						78	75	NA
169	Microsoft Store	Video Streaming Service	Yes	MSFT	NA	NA																						77	77	NA
170	YouTube (Google)	Video Streaming Service	Yes	GOOGL	NA	NA																						76	75	NA
171	Amazon Prime Video	Video Streaming Service	Yes	AMZN	NA	NA																						75	76	NA
172	Netflix	Internet Retail	Yes	NFLX	NA	NA				NA	NA	NA	NA	NA	NA	NA	84	85	87	86	74	75	79	81	76	79	NA	NA	NA	NA
176	Charles Schwab	Financial Advisors	Yes	SCHW						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA		82	82	82	NA
177	LPL Financial	Financial Advisors	Yes	LPLA						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA		82	78	78	NA
178	Morgan Stanley	Financial Advisors	Yes	MS																							81	79	79	NA
179	Raymond James	Financial Advisors	Yes	RJF																							81	81	80	NA
180	Wells Fargo	Financial Advisors	Yes	WFC																							80	79	79	NA
182	Merrill (Bank of America)	Financial Advisors	Yes	BAC																							79	79	77	NA
183	UBS	Financial Advisors	Yes	UBS				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	80	80	NA
185	O’Reilly Auto Parts	Specialty Retail Stores	Yes	ORLY				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	80	78	NA
186	Foot Locker	Specialty Retail Stores	Yes	FL	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	78	79	NA
189	Costco	Supermarkets	Yes	COST	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	83	83	NA
190	Sam’s Club (Walmart)	Supermarkets	Yes	WMT	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	82	80	80	NA
194	Home Depot	Internet Retail	Yes	HD				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	NA
195	Lowe’s	Internet Retail	Yes	LOW				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	NA
196	Gap	Internet Retail	Yes	GPS				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	78	NA
197	Best Buy	Internet Retail	Yes	BBY				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	NA
198	Groupon Goods	Internet Retail	Yes	GRPN				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	77	NA
199	Staples	Internet Retail	Yes	SPLS				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	77	NA
200	Walgreens	Internet Retail	Yes	WBA				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	75	NA
201	GameStop	Internet Retail	Yes	GME				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	76	NA
202	Walmart	Internet Retail	Yes	WMT				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	74	74	NA
204	Ulta Beauty	Specialty Retail Stores	Yes	ULTA				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	80	NA
206	TripAdvisor	Internet Travel Services	Yes	TRIP				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	82	NA
207	Frontier Communications	Video-on-Demand Service	Yes	FTR				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	67	NA
209	Snapchat	Internet Social Media	Yes	SNAP				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	71	NA
210	Dell	Internet Retail	Yes	DELL				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	NA
211	Wayfair	Internet Retail	Yes	W				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	80	NA
212	Target	Internet Retail	Yes	TGT				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	78	NA
220	Ram (Fiat Chrysler)	Automobiles and Light Vehicles	Yes	RAM	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	80	NA
221	Costco	Internet Retail	Yes	COST						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	81	NA
222	Etsy	Internet Retail	Yes	ETSY						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	82	NA
223	Kohl’s	Internet Retail	Yes	KSS						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	81	NA
224	Nike	Internet Retail	Yes	NKE						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	81	NA
225	Nordstrom	Internet Retail	Yes	JWN						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	82	NA
226	Apple	Internet Retail	Yes	AAPL						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	78	NA
227	HP Store	Internet Retail	Yes	HPQ						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	81	NA
228	Macy’s	Internet Retail	Yes	M						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	80	NA
229	TD Ameritrade	Financial Advisors	Yes	AMTD				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	NA
231	LG	Household Appliances	Yes	066570.KS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	82	85	83	82	82	NA
233	Amazon	Personal Computers and Internet Retail	Yes	AMZN	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	80	79	82	79	NA
234	Samsung	Personal Computers and Household Appliances	Yes	005930.KS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	83	82	82	81	NA
235	ASUS	Personal Computers	Yes	2357.TW	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	80	78	76	NA
236	Lenovo	Personal Computers	Yes	0992.HK	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	74	76	76	77	74	NA
237	Regions Bank	Banks	Yes	RF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	81	79	78	NA
238	BB&T	Banks	Yes	BBT	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	82	80	79	80	NA
239	Capital One	Banks	Yes	COF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	80	80	81	79	NA
240	U.S. Bank	Banks	Yes	USB	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	77	80	79	79	NA
241	Fifth Third Bank	Banks	Yes	FITB	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	81	76	75	78	NA
242	TD Bank	Banks	Yes	TD	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	79	80	80	77	NA
243	SunTrust Bank	Banks	Yes	STI	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	74	80	80	81	76	NA
244	Citizens Bank	Banks	Yes	CFG	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	70	80	77	78	78	NA
245	Humana	Health Insurance	Yes	HUM	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	71	72	79	78	79	NA
247	Samsung	Household Appliances	Yes	005930.KS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	84	78	80	80	NA
248	Fiat (Fiat Chrysler)	Automobiles and Light Vehicles	Yes	FCAU	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	NA	75	78	77	NA
250	Cracker Barrel	Full-Service Restaurants	Yes	CBRL				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	83	84	81	82	NA
251	Red Robin	Full-Service Restaurants	Yes	RRGB				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	80	73	79	79	NA
253	Denny’s	Full-Service Restaurants	Yes	DENN				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	74	76	77	77	NA
256	Chipotle Mexican Grill	Limited-Service Restaurants	Yes	CMG	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	78	79	79	80	NA
257	Panera Bread	Limited-Service Restaurants	Yes	PNRA (previously)	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	81	82	81	81	NA
259	Jack in the Box	Limited-Service Restaurants	Yes	JACK	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	72	74	75	74	75	NA
262	Instagram (Facebook)	Internet Social Media	Yes	FB	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	74	75	72	72	NA
264	Infiniti (Nissan)	Automobiles and Light Vehicles	Yes	7201.T	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	84	NA	78	82	NA
265	Mitsubishi	Automobiles and Light Vehicles	Yes	7211.T	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	79	78	79	76	NA
266	Cigna	Health Insurance	Yes	CI	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	60	67	66	73	72	NA
268	Primerica	Life Insurance	Yes	PRI	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	75	74	78	NA	NA
269	Albertsons Companies	Health and Personal Care Stores	Yes	ACI	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	69	83	78	78	75	NA
270	Petco	Specialty Retail Stores	Yes	WOOF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	78	77	78	77	NA
271	Burlington	Specialty Retail Stores	Yes	BURL				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	76	79	77	76	76	NA
272	L Brands	Specialty Retail Stores	Yes	LB						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	81	81	85	82	82	NA
273	AutoZone	Specialty Retail Stores	Yes	AZO						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	80	78	78	77	NA
274	Advance Auto Parts	Specialty Retail Stores	Yes	AAP						NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	72	79	79	78	78	NA
275	Abercrombie & Fitch	Specialty Retail Stores	Yes	ANF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	65	76	79	78	79	NA
278	Windstream	Internet Service Providers	Yes	WINMQ	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	59	57	56	57	NA
280	U.S. Cellular	Wireless Telephone Service	Yes	USM	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	72	74	74	74	NA
281	Johnson & Johnson	Personal Care and Cleaning Products	Yes	JNJ	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	82	81	82	77	NA
283	Dick’s Sporting Goods	Specialty Retail Stores	Yes	DKS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	78	75	76	NA
284	Ahold Delhaize	Supermarkets	Yes	AD	NA	NA	NA	NA																		76	79	78	77	NA
286	Ross Stores	Department and Discount Stores	Yes	ROST	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	74	76	76	77	76	NA
288	Allstate	Life Insurance	Yes	ALL	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	82	79	75	81	NA
291	Lincoln Financial	Life Insurance	Yes	LNC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	76	76	78	78	NA
292	Farmers	Life Insurance	Yes	FMNB	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	71	80	77	74	81	NA
295	Nationwide	Property and Casualty Insurance	Yes	NFS	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	75	79	76	80	NA	NA
298	Travelers	Property and Casualty Insurance	Yes	TRV	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	77	80	78	NA	NA
300	Scottrade (TD Ameritrade)	Internet Investment Services	Yes	AMTD	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	83	77	NA		NA
302	Merrill Edge (Bank of America)	Internet Investment Services	Yes	BAC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	79	77	79	74	NA
304	Verizon Communications	Fixed-Line Telephone Service	Yes	VZ		NA	NA	NA			73	71	73	73	70	69	72	70	71	73	71	70	74	73	68	72	73	72	73	NA
307	DIRECTV (AT&T)	Subscription Television Service	Yes	T							70	70	72	71	67	71	67	68	71	68	69	68	72	69	68	68	68	64	66	NA
308	DISH Network	Subscription Television Service	Yes	DISH							71	68	71	71	68	68	67	65	64	71	67	69	70	67	67	67	67	67	67	NA
309	Time Warner Cable (Charter Communications)	Subscription Television Service	Yes	CHTR							63	61	61	60	61	61	58	59	59	61	59	63	60	56	51	59	60	NA		NA
311	AT&T	Wireless Telephone Service	Yes	T										63	62	63	68	71	67	69	66	69	70	68	70	71	72	74	74	NA
314	T-Mobile	Wireless Telephone Service	Yes	TMUS										NA	64	69	70	71	71	73	70	69	68	69	70	74	73	76	76	NA
316	Kyocera	Cellular Telephones	Yes	6971.T										70	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
318	Samsung	Cellular Telephones	Yes	005930.KS	NA	NA	NA							73	71	73	70	71	70	76	74	71	76	81	80	80	80	80	81	NA
321	Spectrum (Charter Communications)	Subscription Television Service	Yes	CHTR		NA	NA				63	53	55	56	56	55	55	54	51	60	59	59	64	60	63	60	63	58	59	NA
322	Universal Studios	Motion Pictures	Yes	CMCSA	74	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
323	Walt Disney	Motion Pictures	Yes	DIS	80	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
327	AT&T	Fixed-Line Telephone Service	Yes	T	83	83	80	81	79	75	73	73	76	76	72	71	70	75	71	75	71	70	73	72	65	70	71	72	72	NA
329	Gannett	Newspapers	Yes	GCI	66	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
331	New York Times	Newspapers	Yes	NYT	70	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
334	U-verse TV (AT&T)	Subscription Television	Yes	T		NA	NA				NA	NA	NA	NA	NA	NA	NA	NA	NA	72	68	68	71	69	69	69	70	70	69	NA
337	Olive Garden (Darden)	Full-Service Restaurants	Yes	DRI													80	82	81	84	82	80	83	80	79	81	81	80	79	NA
338	McDonald’s	Limited-Service Restaurants	Yes	MCD	63	60	60	61	61	59	62	61	64	NA	62	63	64	69	70	67	72	73	73	71	67	69	69	69	69	NA
339	Papa John’s	Limited-Service Restaurants	Yes	PZZA	NA	NA	NA	NA	76	77	78	76	76	NA	78	79	77	76	75	80	79	83	82	82	78	82	82	80	80	NA
340	Pizza Hut (Yum! Brands)	Limited-Service Restaurants	Yes	YUM	66	63	71	71	68	70	71	70	75	NA	71	76	72	76	74	78	81	78	80	82	78	77	76	80	80	NA
341	Starbucks	Limited-Service Restaurants	Yes	SBUX	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	77	76	78	80	76	80	76	74	75	77	78	79	NA
342	Taco Bell (Yum! Brands)	Limited-Service Restaurants	Yes	YUM	66	66	67	64	64	63	66	67	68	NA	72	70	69	70	73	74	76	77	74	72	72	75	76	74	75	NA
343	Wendy’s	Limited-Service Restaurants	Yes	WEN	73	71	69	73	71	70	72	74	74	NA	75	76	78	73	76	77	77	78	79	78	73	76	76	77	77	NA
344	American	Airlines	Yes	AAL	71	71	62	67	64	63	62	63	67	66	64	62	60	62	60	63	63	64	65	66	66	72	76	74	73	NA
346	Delta	Airlines	Yes	DAL	72	67	69	65	68	66	61	66	67	67	65	64	59	60	64	62	56	65	68	71	71	71	76	74	75	NA
348	Southwest	Airlines	Yes	LUV	76	76	76	74	72	70	70	74	75	73	74	74	76	79	81	79	81	77	81	78	78	80	80	80	79	NA
349	United	Airlines	Yes	UAL	67	70	68	65	62	62	59	64	63	64	61	63	56	56	56	60	61	62	62	60	60	68	70	67	70	NA
351	Facebook	Internet Social Media	Yes	FB																64	66	61	62	67	75	68	68	67	63	NA
353	KFC (Yum! Brands)	Limited-Service Restaurants	Yes	YUM	68	69	67	64	64	65	63	69	71	NA	69	70	71	70	69	75	75	75	81	74	73	78	78	77	78	NA
354	Outback Steakhouse	Full-Service Restaurants	Yes	BLMN													79	76	77	80	81	81	81	80	78	77	80	79	79	NA
355	Red Lobster	Full-Service Restaurants	Yes	DRI													78	79	80	83	82	83	83	78	77	79	81	79	78	NA
356	Best Western	Hotels	Yes	BW	70	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	70	75	76	76	76	79	74	74	75	76	77	77	NA
357	Choice	Hotels	Yes	CHH	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	71	76	74	74	76	75	74	73	74	74	73	74	NA
358	Hilton	Hotels	Yes	HLT	75	75	75	72	74	77	74	76	74	77	76	78	76	78	79	80	80	80	80	78	80	81	81	82	80	NA
359	Holiday Inn	Hotels	Yes	HLT	69	NA	NA	69	68	71	71	69	72	73	69	72	72	NA												NA
360	Hyatt	Hotels	Yes	H	75	77	77	75	73	74	73	75	77	74	74	75	77	78	74	79	77	76	79	78	80	79	80	79	79	NA
361	InterContinental	Hotels	Yes	IHG	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	74	75	78	76	77	78	78	76	76	78	77	78	NA
362	Marriott	Hotels	Yes	MAR	76	77	76	76	77	74	77	76	76	76	76	75	79	78	77	80	79	78	82	81	80	80	80	81	80	NA
365	Starwood (Marriott)	Hotels	Yes	HOT	NA	NA	NA	NA	NA	73	71	69	73	73	75	75	76	74	74	77	79	75	78	76	76	78	79	79	NA	NA
366	Wyndham	Hotels	Yes	WH	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	70	70	70	73	70	72	72	68	70	71	70	70	NA
367	Burger King	Limited-Service Restaurants	Yes	BKW	65	67	68	64	66	67	65	68	68	NA	71	70	69	71	69	74	75	75	76	76	72	76	77	76	76	NA
370	Charles Schwab	Internet Investment Services	Yes	SCHW						76	72	76	75	71	74	80	82	78	79	80	79	77	84	80	78	81	80	79	81	NA
371	Chevron	Gasoline Stations	Yes	CVX	81	78	77	81	76	76	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
372	Exxon	Gasoline Stations	Yes	XOM	80	79	78	80	NA		NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
373	Exxon Mobil	Gasoline Stations	Yes	XOM					77	75	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
376	Shell Oil	Gasoline Stations	Yes	RDS.A	80	77	81	78	75	77	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
379	Barnes & Noble	Specialty Retail Stores	Yes	BKS							NA	NA	NA	NA	NA	NA	83	83	84	82	79	82	82	81	79	81	81	81	81	NA
380	Best Buy	Specialty Retail Stores	Yes	BBY							NA	NA	72	72	71	76	74	74	74	77	77	78	77	77	74	77	78	78	77	NA
383	Costco	Department and Discount Stores	Yes	COST					79	77	76	79	80	79	79	81	81	83	81	82	83	83	84	84	81	83	83	83	83	NA
384	Gap	Specialty Retail Stores	Yes	GPS							NA	NA	NA	NA	NA	NA	75	75	75	74	77	76	77	75	75	79	77	78	79	NA
386	BP	Gasoline Stations	Yes	BP	NA	NA	NA	81	NA		NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
387	E*Trade	Internet Investment Services	Yes	ETFC						66	66	69	71	70	71	74	73	69	74	76	79	73	76	76	74	80	79	79	78	NA
389	TD Ameritrade	Internet Investment Services	Yes	AMTD						NA	NA	NA	NA	NA	NA	77	80	71	76	77	78	77	74	74	73	78	79	77	79	NA
390	1-800-FLOWERS.COM	Internet Retail	Yes	FLWS						69	76	78	76	79	77	77	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
391	Amazon	Internet Retail	Yes	AMZN						84	84	88	88	84	87	87	88	86	86	87	86	85	88	86	83	86	85	82	83	NA
394	eBay	Internet Retail	Yes	EBAY						80	82	82	84	80	81	80	81	78	79	81	81	83	80	79	75	81	81	80	79	NA
397	Overstock	Internet Retail	Yes	OSTK						NA	NA	NA	NA	NA	NA	NA	80	82	82	83	83	81	79	77	73	79	81	80	79	NA
401	Home Depot	Specialty Retail Stores	Yes	HD							75	71	73	73	67	70	67	70	72	75	78	77	79	76	73	80	76	76	78	NA
402	Lowe’s	Specialty Retail Stores	Yes	LOW							75	76	77	76	78	74	75	76	79	77	79	79	82	81	74	79	78	78	78	NA
404	Microsoft	Computer Software	Yes	MSFT												73	70	69	70	76	78	75	74	75	75	80	76	79	77	NA
406	CenturyLink	Fixed-Line Telephone Service	Yes	CTL	83	80	76	76	74	70	71	74	73	65	66	64	66	70	68	70	70	66	71	71	70	68	66	66	65	NA
416	Fox Entertainment	Motion Pictures	Yes	FOX	79	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
417	Whole Foods (Amazon)	Supermarkets	Yes	WFM	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	73	75	76	79	80	80	78	81	73	81	81	79	79	NA
418	Walmart	Supermarkets	Yes	WMT	NA	NA	NA	NA	NA	NA	NA	NA	NA	70	70	69	71	68	71	71	69	72	72	71	67	74	73	72	73	NA
419	Office Depot	Specialty Retail Stores	Yes	ODP							NA	NA	NA	NA	NA	NA	78	75	76	81	79	84	79	78	NA	79	77	77	76	NA
421	Sam’s Club (Walmart)	Department and Discount Stores	Yes	WMT		75	72	75	78	74	78	77	77	75	76	78	77	79	79	78	81	80	80	80	76	81	80	80	81	NA
423	TJX	Specialty Retail Stores	Yes	TJX							NA	NA	NA	NA	NA	NA	74	73	78	76	78	76	79	78	78	80	80	79	79	NA
424	Albertsons Companies	Supermarkets	Yes	ACI	77	77	72	70	73	70	72	73	73	69	71	NA	NA	NA	NA	NA	NA	NA	NA	74	68	75	76	75	75	NA
428	Kroger	Supermarkets	Yes	KR	76	74	74	73	74	71	75	75	71	73	74	76	75	77	78	78	79	79	80	78	76	79	81	79	79	NA
435	Chase	Banks	Yes	JPM		NA	NA							70	70	72	74	73	68	67	70	74	76	74	71	75	79	80	79	NA
437	HCA	Hospitals	Yes	HCA	73	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
440	Apple	Cellular Telephones	Yes	AAPL				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	81	79	80	81	81	81	81	NA
444	Dunkin’	Limited-Service Restaurants	Yes	DNKN	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	79	80	75	78	80	79	78	78	NA
445	JetBlue	Airlines	Yes	JBLU	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	81	83	79	81	80	82	79	79	NA
447	Pinterest	Internet Social Media	Yes	PINS				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	69	72	76	78	76	78	80	80	NA
448	Twitter	Internet Social Media	Yes	TWTR				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	64	65	69	71	65	70	66	69	NA
449	LinkedIn (Microsoft)	Internet Social Media	Yes	MSFT				NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	63	62	67	68	65	65	66	69	NA
450	Travelers Group	Life Insurance	Yes	TRV	NA																									NA
451	Prudential	Life Insurance	Yes	PRU	74	68	70	71	69	71	76	74	73	77	72	76	77	79	77	77	79	79	78	79	77	77	78	77	78	NA
452	KeyBank	Banks	Yes	KEY	76	70	65	65	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	75	77	76	NA
455	PNC Bank	Banks	Yes	PNC	NA	69	69	66	NA	67	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	78	78	78	79	NA
457	Wells Fargo	Banks	Yes	WFC	71	65	62	67	65	67	66	69	68	70	67	72	69	72	73	73	73	71	72	72	75	76	74	74	76	NA
458	Aetna (CVS Health)	Health Insurance	Yes	CVS							64	65	66	63	65	65	66	65	70	68	67	67	69	65	68	75	74	75	76	NA
460	UnitedHealth	Health Insurance	Yes	UNH							66	68	64	66	64	68	65	63	72	65	72	70	70	72	66	70	73	73	75	NA
461	Anthem	Health Insurance	Yes	ANTM							NA	NA	NA	NA	NA	69	66	68	67	69	74	70	73	66	69	75	NA	NA	NA	NA
463	MetLife	Life Insurance	Yes	MET	73	74	75	76	73	72	74	75	77	77	71	78	76	78	77	78	77	78	77	76	75	76	77	81	79	NA
466	Toshiba	Personal Computers	Yes	TOSBF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	77	78	75	73	76	75	71	77	NA
467	Dillard’s	Department and Discount Stores	Yes	DDS	74	74	73	71	68	72	75	75	75	77	76	75	76	75	78	78	80	79	81	81	80	83	79	79	78	NA
468	Target (Discount Stores)	Department and Discount Stores	Yes	TGT	76	77	73	74	74	73	77	78	77	NA																NA
469	CVS	Health and Personal Care Stores	Yes	CVS											74	78	76	77	77	74	73	75	76	75	71	76	78	77	77	NA
471	Walgreens	Health and Personal Care Stores	Yes	WBA											76	76	78	77	77	77	75	76	76	77	74	76	77	77	75	NA
472	Procter & Gamble	Personal Care and Cleaning Products	Yes	PG	87	85	81	83	81	84	82	81	85	86	82	84	85	85	85	82	82	82	84	82	75	83	82	82	84	NA
473	Acura (Honda)	Automobiles and Light Vehicles	Yes	HMC	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	83	77	83	76	80	81	78	NA
474	Spectrum (Charter Communications)	Fixed-Line Telephone Service	Yes	CHTR	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	72	69	69	65	71	66	67	NA
478	Spectrum (Charter Communications)	Internet Service Providers	Yes	CHTR																			65	61	57	63	65	60	59	NA
479	CenturyLink	Internet Service Providers	Yes	CTL																			64	65	60	63	59	58	59	NA
481	Xfinity (Comcast)	Internet Service Providers	Yes	CMCSA																			62	57	56	59	60	60	61	NA
482	Target (Department Stores)	Department and Discount Stores	Yes	TGT	76	74	72	74	72	72	74	75	73	NA																NA
484	Dollar General	Department and Discount Stores	Yes	DG	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	78	75	79	80	78	78	80	75	74	78	73	73	73	NA
486	Macy’s	Department and Discount Stores	Yes	M											74	71	75	74	71	76	77	78	76	79	73	79	77	77	78	NA
487	Kohl’s	Department and Discount Stores	Yes	KSS	NA	NA	NA	NA	NA	NA	NA	84	79	79	80	80	79	80	79	81	81	81	81	80	77	79	79	79	79	NA
488	Nordstrom	Department and Discount Stores	Yes	JWN	83	82	80	79	76	76	76	NA	NA	NA	NA	NA	80	80	83	82	84	84	83	86	82	80	81	79	79	NA
490	Target	Department and Discount Stores	Yes	TGT										75	78	77	77	77	80	78	80	81	77	80	75	79	77	77	78	NA
491	Walmart	Department and Discount Stores	Yes	WMT	81	74	76	75	72	73	75	74	75	73	72	72	68	70	71	73	70	71	71	68	66	72	71	72	71	NA
498	ABC	Network/Cable TV News	Yes	DIS	77	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA
500	YouTube (Google)	Internet Social Media	Yes	GOOGL																73	74	73	71	73	76	77	74	75	78	NA
501	Philip Morris	Cigarettes	Yes	PM	81	79	77	75	75	75	75	74	76	78	78	77	76	79	72	77	80	80	NA	NA	NA	NA	NA	NA	NA	NA
503	Coca-Cola	Soft Drinks	Yes	KO	85	87	84	82	84	86	81	85	83	83	84	82	84	85	84	84	85	84	84	83	79	81	85	81	81	NA
504	Keurig Dr Pepper	Soft Drinks	Yes	KDP	85	86	83	88	85	86	85	86	89	84	83	86	86	87	86	85	82	87	86	82	79	86	82	84	82	NA
505	PepsiCo	Soft Drinks	Yes	PEP	87	86	83	83	82	85	84	86	83	83	82	86	84	84	86	84	85	84	85	83	78	84	85	80	82	NA
507	Hanesbrands	Apparel	Yes	HBI	81	75	81	77	78	78	76	78	80	79	79	82	82	80	82	81	82	79	81	78	74	81	79	82	80	NA
509	Levi Strauss	Apparel	Yes	LEVI	83	80	81	75	76	79	80	78	80	80	79	79	80	78	83	81	81	82	82	80	78	81	81	79	77	NA
511	VF	Apparel	Yes	VFC	80	80	81	79	78	82	84	82	84	79	82	82	84	83	81	85	83	82	81	84	76	80	80	82	79	NA
512	Adidas	Athletic Shoes	Yes	ADS.DE	80	77	74	74	75	78	73	76	74	77	75	78	77	78	78	82	80	77	80	77	77	83	81	78	83	NA
513	Nike	Athletic Shoes	Yes	NKE	78	77	74	73	73	78	74	76	76	78	75	72	75	78	79	80	80	80	78	78	78	80	79	77	81	NA
517	Electrolux	Household Appliances	Yes	ELUX-B	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	80	81	80	79	79	78	82	78	79	81	81	81	78	79	NA
521	Whirlpool	Household Appliances	Yes	WHR	82	85	82	85	84	86	83	83	82	83	81	82	84	80	83	83	82	83	82	81	80	81	80	79	80	NA
522	Acer	Personal Computers	Yes	ACIDF	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	NA	72	74	77	77	79	77	76	70	78	75	75	77	NA
523	Apple	Personal Computers	Yes	AAPL	75	76	70	69	72	75	73	73	77	81	81	83	79	85	84	86	87	86	87	84	84	84	83	83	83	NA
525	Dell	Personal Computers	Yes	DELL	NA	NA	72	74	76	80	78	76	78	79	74	78	74	75	75	77	77	81	79	76	78	78	76	73	77	NA
526	HP	Personal Computers	Yes	HPQ	80	77	75	72	74	74	73	71	70	71	73	75	76	73	74	77	78	79	80	74	73	77	77	78	78	NA
529	Anheuser-Busch InBev	Breweries	Yes	BUD	80	79	81	81	78	81	80	82	82	79	82	81	82	82	85	82	81	81	81	77	74	84	84	85	84	NA
530	Molson Coors	Breweries	Yes	TAP	84	79	80	84	78	82	78	79	80	78	82	83	82	83	81	81	81	NA					84	81	81	NA
532	Campbell Soup	Food Manufacturing	Yes	CPB	81	84	81	80	81	81	81	80	83	79	81	80	83	80	82	82	79	81	84	83	79	80	80	81	81	NA
534	Hill’s Pet Nutrition (Colgate-Palmolive)	Pet Food	Yes	CL			85	83	86	82	84	84	85	83	82	83	85	81	80	82	84	83	NA	NA	NA	NA	NA	NA	NA	NA
535	Iams (Procter & Gamble)	Pet Food	Yes	PG			NA	NA	NA	NA	80	82	85	82	81	83	82	81	85	80	81	83	NA	NA	NA	NA	NA	NA	NA	NA
537	Nestle	Pet Food	Yes	NSRGF			83	83	84	81	81	NA																		NA
540	Bank of America	Banks	Yes	BAC	67	65	61	62	61	63	68	70	74	72	72	72	72	73	67	68	68	66	69	69	68	75	77	76	77	NA
548	Tyson	Food Manufacturing	Yes	TSN	80	79	80	79	79	81	80	80	81	79	79	78	78	80	82	77	79	81	80	79	78	82	80	81	80	NA
549	Conagra	Food Manufacturing	Yes	CAG	83	82	80	80	80	82	81	83	84	82	86	83	83	84	78	83	83	84	83	82	80	80	82	81	81	NA
551	General Mills	Food Manufacturing	Yes	GIS	81	86	81	82	81	82	83	83	83	84	82	84	83	84	83	83	83	83	87	85	78	84	82	84	82	NA
553	Hershey	Food Manufacturing	Yes	HSY	88	88	84	84	86	85	86	87	85	87	86	86	87	85	87	86	84	85	86	86	79	84	86	86	84	NA
554	Kellogg	Food Manufacturing	Yes	K	84	85	81	83	81	83	83	81	82	81	81	85	83	85	85	81	80	83	85	81	80	81	81	81	80	NA
555	Kraft Heinz	Food Manufacturing	Yes	KHC	84	85	82	84	83	82	82	81	83	84	84	86	84	85	83	81	83	81	86	84	79	83	82	82	81	NA
558	Nestle (Ferrero)	Food Manufacturing	Yes	NSRGF	86	82	83	83	81	84	83	83	83	83	83	84	83	83	85	84	84	85	83	85	78	84	82	82	81	NA
560	Quaker (PepsiCo)	Food Manufacturing	Yes	PEP	82	82	85	83	83	86	86	87	86	86	88	85	86	87	87	86	84	86	87	85	80	83	84	84	84	NA

score_data

## # A tibble: 318 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1     0 FedEx   Consu… Yes     FDX    85     86     82     80     83     83    
##  2     1 Atmos … Inves… Yes     ATO    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  3     3 Center… Inves… Yes     CNP    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  4     4 UPS     Consu… Yes     UPS    83     87     82     77     79     81    
##  5     5 NextEr… Inves… Yes     NEE    77     74     69     75     74     76    
##  6     6 Consol… Inves… Yes     ED     76     74     71     69     73     71    
##  7     7 Sempra… Inves… Yes     SRE    <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  8     8 NiSour… Inves… Yes     NI     <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  9     9 Southe… Inves… Yes     SO     78     76     77     79     78     80    
## 10    10 Domini… Inves… Yes     D      75     72     74     75     74     75    
## # … with 308 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded

How many unique company tickers are in the dataset?

score_data %>% pull(ticker) %>% unique() %>% length()

## [1] 235

gather() the data

score_data_long <- gather(score_data %>% select(-`...1`, -publicly_traded), year, score, -ticker, -company_name, -sector, na.rm = TRUE)
score_data_long$score <- as.numeric(score_data_long$score) #convert score from chr to numeric value

## Warning: NAs introduced by coercion

score_data_long

## # A tibble: 4,966 × 5
##    company_name         sector                          ticker year  score
##    <chr>                <chr>                           <chr>  <chr> <dbl>
##  1 FedEx                Consumer Shipping               FDX    1995     85
##  2 UPS                  Consumer Shipping               UPS    1995     83
##  3 NextEra Energy       Investor-Owned Energy Utilities NEE    1995     77
##  4 Consolidated Edison  Investor-Owned Energy Utilities ED     1995     76
##  5 Southern Company     Investor-Owned Energy Utilities SO     1995     78
##  6 Dominion Energy      Investor-Owned Energy Utilities D      1995     75
##  7 Edison International Investor-Owned Energy Utilities EIX    1995     74
##  8 CMS Energy           Investor-Owned Energy Utilities CMS    1995     76
##  9 Exelon               Investor-Owned Energy Utilities EXC    1995     NA
## 10 Entergy              Investor-Owned Energy Utilities ETR    1995     76
## # … with 4,956 more rows

Load the corresponding stock data

stock_data <- read_csv("stock_data.csv")
names(stock_data)[1] <- "ticker" #rename index to ticker 
stock_data

## # A tibble: 201 × 28
##    ticker `1995` `1996` `1997` `1998` `1999` `2000` `2001` `2002` `2003` `2004`
##    <chr>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 FDX     15.1   18.3   22.2   30.5   44.5   42.4   39.5   51.7   54.4   67.7 
##  2 ATO     16.9   22.9   24     29.6   32.5   20     24.5   21.2   23.5   24.5 
##  3 CNP     15.0   20.3   19.1   22.4   27.2   19.2   36.7   22.6    8.56   9.66
##  4 NEE      4.36   5.77   5.75   7.41   7.67   5.30   8.86   7.03   7.54   8.18
##  5 ED      25.9   32     28.8   41     52.8   34.4   38.3   40.1   43.0   43.1 
##  6 NI       5.82   7.49   7.78   9.69  12.0    7.00  12.0    9.08   7.85   8.57
##  7 SO      12.2   15.0   13.9   15.9   17.8   14.1   20.0   25.3   28.5   30.2 
##  8 D       17.9   20.5   19.2   21.2   23.4   19.5   32.9   30     27.5   31.9 
##  9 WEC     12.9   15.2   13.4   14.4   15.6    9.75  11.3   11.3   12.6   16.6 
## 10 EIX     14.6   17.5   20     27.2   28     25.5   15.5   15.1   11.9   21.7 
## # … with 191 more rows, and 17 more variables: `2005` <dbl>, `2006` <dbl>,
## #   `2007` <dbl>, `2008` <dbl>, `2009` <dbl>, `2010` <dbl>, `2011` <dbl>,
## #   `2012` <dbl>, `2013` <dbl>, `2014` <dbl>, `2015` <dbl>, `2016` <dbl>,
## #   `2017` <dbl>, `2018` <dbl>, `2019` <dbl>, `2020` <dbl>, `2021` <dbl>

Merge the score data and price data together by ticker

# gather() the data so it can be merged
stock_data_long <- gather(stock_data, year, price, -ticker, na.rm = TRUE)

# left_join() to combine the two 
analysis_data <- score_data_long %>% mutate(ticker_year = paste0(ticker, "_", year)) %>% left_join(stock_data_long %>% mutate(ticker_year = paste0(ticker, "_", year)) %>% select(-ticker, -year), by=c("ticker_year"="ticker_year")) %>% select(-ticker_year)
analysis_data

## # A tibble: 4,966 × 6
##    company_name         sector                          ticker year  score price
##    <chr>                <chr>                           <chr>  <chr> <dbl> <dbl>
##  1 FedEx                Consumer Shipping               FDX    1995     85 15.1 
##  2 UPS                  Consumer Shipping               UPS    1995     83 NA   
##  3 NextEra Energy       Investor-Owned Energy Utilities NEE    1995     77  4.36
##  4 Consolidated Edison  Investor-Owned Energy Utilities ED     1995     76 25.9 
##  5 Southern Company     Investor-Owned Energy Utilities SO     1995     78 12.2 
##  6 Dominion Energy      Investor-Owned Energy Utilities D      1995     75 17.9 
##  7 Edison International Investor-Owned Energy Utilities EIX    1995     74 14.6 
##  8 CMS Energy           Investor-Owned Energy Utilities CMS    1995     76 23   
##  9 Exelon               Investor-Owned Energy Utilities EXC    1995     NA  8.74
## 10 Entergy              Investor-Owned Energy Utilities ETR    1995     76 21.9 
## # … with 4,956 more rows

Data Exploration

How many companies per sector?

ggplot(score_data, aes(x = sector)) +
  geom_bar(fill = "steelblue") +
  labs(title = "Publicly Traded Companies w/ ACSI Data by Sector", x = "Sector", y = "Count") +
  geom_text(stat = "count", aes(label = ..count..), hjust = -1, color="black", size=2) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) + 
  coord_flip() +
  theme_bw()

## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.

What does satisfaction look like across all sectors over all dates available?

score_data_long %>% ggplot(aes(color=sector, y = score, x=reorder(sector,score,na.rm = TRUE))) + geom_boxplot(alpha=0.4) + geom_jitter(size=0.4, alpha=0.9) + theme_bw() +
    theme(axis.text.x = element_text(angle = 0, vjust = 0.5)) + coord_flip() + theme(legend.position = "none") + ggtitle(paste0("")) + ylab("ACSI Score") + xlab("")  +
  ylim(c(45, 100))

## Warning: Removed 999 rows containing non-finite values (`stat_boxplot()`).

## Warning: Removed 999 rows containing missing values (`geom_point()`).

What sectors have the highest satisfaction scores across all the years available?

Calculate the mean score for each sector by year, then take the average across years and rank them

sector_year_means <- score_data_long %>% 
  group_by(year, sector) %>% 
  summarize(mean_score = mean(score, na.rm = TRUE))

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

sector_means <- sector_year_means %>% 
  group_by(sector) %>% 
  summarize(mean_score = mean(mean_score, na.rm = TRUE)) 

#arrange from top to bottom
sector_means <- sector_means %>% 
  arrange(desc(mean_score))

sector_means %>% 
  mutate(rank = row_number(desc(mean_score)))

## # A tibble: 50 × 3
##    sector                                      mean_score  rank
##    <chr>                                            <dbl> <int>
##  1 Soft Drinks                                       84       1
##  2 Personal Care and Cleaning Products               83.5     2
##  3 Pet Food                                          82.7     3
##  4 Food Manufacturing                                82.7     4
##  5 Consumer Shipping                                 82.0     5
##  6 Household Appliances                              81.9     6
##  7 Televisions and Video Players                     81.8     7
##  8 Automobiles and Light Vehicles                    81.7     8
##  9 Internet Search Engines and Information           81.5     9
## 10 Personal Computers and Household Appliances       81.2    10
## # … with 40 more rows

Average stock price for companies with satisfaction data per year?

Add in S&P 500 stock price information

sp_500_data <- read_csv("sp_500_stock_df.csv")

## New names:
## Rows: 1 Columns: 28
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (1): ...1 dbl (27): 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
## 2005, ...
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

names(sp_500_data)[1] <- "ticker"
sp_500_data <- gather(sp_500_data, year, price, -ticker, na.rm = TRUE)
sp_500_data

## # A tibble: 27 × 3
##    ticker year  price
##    <chr>  <chr> <dbl>
##  1 SPY    1995   45.7
##  2 SPY    1996   61.4
##  3 SPY    1997   74.4
##  4 SPY    1998   97.3
##  5 SPY    1999  123. 
##  6 SPY    2000  148. 
##  7 SPY    2001  132  
##  8 SPY    2002  115. 
##  9 SPY    2003   88.8
## 10 SPY    2004  112. 
## # … with 17 more rows

# Sort the dataframe by ticker and year
stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),]

# Mark both data types
stock_data_long$type <- "ACSI Surveyed Companies"
sp_500_data$type <- "S&P 500"

# merge them together
stock_data_long %<>% full_join(sp_500_data)

## Joining, by = c("ticker", "year", "price", "type")

# Use the 'dplyr' package to group the data by ticker and calculate the percent change from one year to the next
library(dplyr)

stock_data_long <- stock_data_long %>% 
  group_by(ticker) %>% 
  mutate(price_change_from_prev_year = (price - lag(price))/lag(price))

stock_data_long

## # A tibble: 4,338 × 5
## # Groups:   ticker [202]
##    ticker    year  price type                    price_change_from_prev_year
##    <chr>     <chr> <dbl> <chr>                                         <dbl>
##  1 005930.KS 2000   6000 ACSI Surveyed Companies                    NA      
##  2 005930.KS 2001   3160 ACSI Surveyed Companies                    -0.473  
##  3 005930.KS 2002   5580 ACSI Surveyed Companies                     0.766  
##  4 005930.KS 2003   6280 ACSI Surveyed Companies                     0.125  
##  5 005930.KS 2004   9020 ACSI Surveyed Companies                     0.436  
##  6 005930.KS 2005   9050 ACSI Surveyed Companies                     0.00333
##  7 005930.KS 2006  13280 ACSI Surveyed Companies                     0.467  
##  8 005930.KS 2007  12400 ACSI Surveyed Companies                    -0.0663 
##  9 005930.KS 2008  11180 ACSI Surveyed Companies                    -0.0984 
## 10 005930.KS 2009   9070 ACSI Surveyed Companies                    -0.189  
## # … with 4,328 more rows

How many tickers do we have in total now? Not all tickers in the dataset are still available (some are now defunct).

stock_data_long %>% pull(ticker) %>% unique() %>% length()

## [1] 202

# Calculate the median price change from previous year for each year
median_changes <- stock_data_long %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5))

## Warning: Removed 2 rows containing missing values (`geom_col()`).

How many years were median ACSI surveyed company returns higher than the S&P500?

count_highest_types <- function(median_changes) {
  # Convert factor type column to character if needed
  if (is.factor(median_changes$type)) {
    median_changes$type <- as.character(median_changes$type)
  }
  
  highest_types <- c()
  for (x in median_changes$year %>% unique()) {
    yearly_data <- median_changes %>% filter(year == x)
    # Find the type with the highest median_change value
    highest_types <- c(highest_types, yearly_data$type[which.max(yearly_data$median_change)])
  }
  # Count the occurrences of each element in an array
  counts <- table(highest_types)
  
  # Return the counts
  return(counts)
}

count_highest_types(median_changes)

## highest_types
## ACSI Surveyed Companies                 S&P 500 
##                      13                      13

Pretty equivalent…

Now lets compare cumulative performance of ACSI companies and S&P 500

plot_cumulative_performance <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    #get the standard deviation in returns
    annual_mean_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% mean()
    annual_sd_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% sd()
    print(paste0(t, ": ", annual_mean_return, "+/-", annual_sd_return))

    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  # Plot cumulative performance for each trading strategy
  ggplot(df_cumulative, aes(x = year, y = cumulative_return, color = type, group=type)) +
    geom_line(size = 1) +
    scale_y_continuous(labels = scales::dollar, limits=c(0,3000000)) +
    labs(x = "Year", y = "Portfolio Balance", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("")
  
}

acsi_total_data <- median_changes %>% drop_na()

plot_cumulative_performance(median_changes %>% drop_na())

## [1] "ACSI Surveyed Companies: 0.0972256498177776+/-0.151010517168814"
## ACSI Surveyed Companies: 860506.02
## ACSI Surveyed Companies: 760.51%
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.

Compare the mean and standard deviation of median returns by year?

S&P 500

median_changes %>% filter(type == "S&P 500") %>% drop_na() %>% pull(median_change) %>% mean()

## [1] 0.1002879

median_changes %>% filter(type == "S&P 500") %>% drop_na() %>% pull(median_change) %>% sd()

## [1] 0.1782026

ACSI Surveyed Companies

median_changes %>% filter(type == "ACSI Surveyed Companies") %>% drop_na() %>% pull(median_change) %>% mean()

## [1] 0.09722565

median_changes %>% filter(type == "ACSI Surveyed Companies") %>% drop_na() %>% pull(median_change) %>% sd()

## [1] 0.1510105

The S&P 500 has a 10.0% mean return with a 17.8% SD over the time period available while ACSI Surveyed Companies had a 9.7% mean return.

Overall, it looks like the companies that were surveyed for inclusion in the ACSI had a cumulative higher performance than the S&P 500 despite having lower mean returns. But this can be skewed by a few good years (or reduced downturns, not overall more robust performance),

Analysis

Does picking the top 5/10/25% of companies by consumer satisfaction score each year beat the bottom 5/10/25%?

We need to label each row for each year as belonging to the top or bottom cutoff portion

label_data <- function(df, top_cutoff, bottom_cutoff) {
  library(dplyr)
  
  df_labeled <- df %>% 
    group_by(year) %>% 
    mutate(top_score = quantile(score, 1 - top_cutoff),
           bottom_score = quantile(score, bottom_cutoff),
           label = case_when(score >= top_score ~ "top",
                             score <= bottom_score ~ "bottom",
                             TRUE ~ "none")) %>% 
    ungroup()
  
  return(df_labeled)
}

Top and Bottom 5%

Get the labels for each row, for each year

We add one to each year, since we will be looking at the price for the next year after the score comes out. We want to take the median return for each strategy over that time period.

labeled_data <- label_data(score_data_long %>% drop_na(), 0.05, 0.05)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 5% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 90% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 5% Companies (ACSI Score)"

Merge them together

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data)# %>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

# why is it short, shouldn't it contain almost all the data? 
compiled_data

## # A tibble: 241 × 6
## # Groups:   ticker [41]
##    ticker year  price type    price_change_from_prev_year ticker_year
##    <chr>  <chr> <dbl> <chr>                         <dbl> <chr>      
##  1 SPY    1995   45.7 S&P 500                      NA     SPY_1995   
##  2 SPY    1996   61.4 S&P 500                       0.344 SPY_1996   
##  3 SPY    1997   74.4 S&P 500                       0.211 SPY_1997   
##  4 SPY    1998   97.3 S&P 500                       0.308 SPY_1998   
##  5 SPY    1999  123.  S&P 500                       0.268 SPY_1999   
##  6 SPY    2000  148.  S&P 500                       0.202 SPY_2000   
##  7 SPY    2001  132   S&P 500                      -0.110 SPY_2001   
##  8 SPY    2002  115.  S&P 500                      -0.128 SPY_2002   
##  9 SPY    2003   88.8 S&P 500                      -0.228 SPY_2003   
## 10 SPY    2004  112.  S&P 500                       0.258 SPY_2004   
## # … with 231 more rows

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 5% Companies (ACSI Score)", "Mid 90% Companies (ACSI Score)", "Bottom 5% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank())

## Warning: Removed 1 rows containing missing values (`geom_col()`).

View cumulative performance

p5_data <- median_changes %>% drop_na()

p5 <- plot_cumulative_performance(median_changes %>% drop_na())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 5% Companies (ACSI Score): 0.100672606229892+/-0.162447844477771"
## Top 5% Companies (ACSI Score): 898167.54
## Top 5% Companies (ACSI Score): 798.17%

p5

How many times was each strategy the highest performing?

count_highest_types(median_changes)

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                            14                            12

What about looking at specific years? This will be analyzed later to see if performance is declining in recent years…

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             3                             2

count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             1                             4

count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             1                             4

count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             4                             1

count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))

## highest_types
##                       S&P 500 Top 5% Companies (ACSI Score) 
##                             4                             1

Top and Bottom 10%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.1, 0.1)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 10% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 80% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 10% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 10% Companies (ACSI Score)", "Mid 80% Companies (ACSI Score)", "Bottom 10% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

p10_data <- median_changes %>% drop_na()

p10 <- plot_cumulative_performance(median_changes %>% drop_na())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 10% Companies (ACSI Score): 0.0751997137007673+/-0.169191738808098"
## Top 10% Companies (ACSI Score): 481790.32
## Top 10% Companies (ACSI Score): 381.79%

p10

How many times was each strategy the highest performing?

count_highest_types(median_changes)

## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                             16                             10

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))

## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              3                              2

count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))

## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              1                              4

count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))

## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              2                              3

count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))

## highest_types
##                        S&P 500 Top 10% Companies (ACSI Score) 
##                              4                              1

count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))

## highest_types
## S&P 500 
##       5

Top and Bottom 25%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.25, 0.25)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 25% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 50% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 25% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 25% Companies (ACSI Score)", "Mid 50% Companies (ACSI Score)", "Bottom 25% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

p25_data <- median_changes %>% drop_na()

p25 <- plot_cumulative_performance(median_changes %>% drop_na())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 25% Companies (ACSI Score): 0.0805406108563645+/-0.157748573704633"
## Top 25% Companies (ACSI Score): 567965.88
## Top 25% Companies (ACSI Score): 467.97%

p25

How many times was each strategy the highest performing?

count_highest_types(median_changes)

## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                             14                             12

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))

## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              3                              2

count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))

## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              2                              3

count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))

## highest_types
## Top 25% Companies (ACSI Score) 
##                              5

count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))

## highest_types
##                        S&P 500 Top 25% Companies (ACSI Score) 
##                              3                              2

count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))

## highest_types
## S&P 500 
##       5

Top and Bottom 1%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.01, 0.01)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 1% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

p1_data <- median_changes %>% drop_na()

p1 <- plot_cumulative_performance(median_changes %>% drop_na())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 1% Companies (ACSI Score): 0.208808022053884+/-0.399131588164006"
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%

p1

## Warning: Removed 1 row containing missing values (`geom_line()`).

Huh, how about that…I decided to just try running 1% after 5/10/25% for fun, and didn’t expect to see anything - but this result actually is the most pronounced of any. Looking at the change by year, it looks like there was extraordinary performance in 2004 (more than doubling of stock price).

How many times was each strategy the highest performing?

count_highest_types(median_changes)

## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                            13                            13

Looking at compative performance by 5 year periods….

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))

## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             3                             2

count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))

## highest_types
## Top 1% Companies (ACSI Score) 
##                             5

count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))

## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             2                             3

count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))

## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             3                             2

count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))

## highest_types
##                       S&P 500 Top 1% Companies (ACSI Score) 
##                             4                             1

What company(s) is driving this?

top_stock_data %>% filter(year == 2004)

## # A tibble: 1 × 5
## # Groups:   ticker [1]
##   ticker year  price type                          price_change_from_prev_year
##   <chr>  <chr> <dbl> <chr>                                               <dbl>
## 1 AMZN   2004   2.64 Top 1% Companies (ACSI Score)                        1.75

Amazon!

What companies are in the top companies and bottom companies?

#top companies
score_data %>% filter(ticker %in% c(top_stock_data %>% pull(ticker) %>% unique())) 

## # A tibble: 36 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1     0 FedEx   Consu… Yes     FDX    85     86     82     80     83     83    
##  2    47 Unilev… Perso… Yes     UL     83     83     82     83     81     85    
##  3    96 Texas … Full-… Yes     TXRH                        <NA>   <NA>   <NA>  
##  4   103 BMW     Autom… Yes     BMWYY  81     81     80     86     86     84    
##  5   104 Cadill… Autom… Yes     GM     84     88     84     88     85     86    
##  6   105 Chevro… Autom… Yes     GM     79     79     78     79     76     80    
##  7   108 Ford    Autom… Yes     F      79     78     77     77     77     77    
##  8   109 GMC (G… Autom… Yes     GM     <NA>   <NA>   80     78     81     81    
##  9   110 Honda   Autom… Yes     HMC    86     83     82     81     83     82    
## 10   131 Buick … Autom… Yes     GM     84     84     83     84     86     86    
## # … with 26 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded

# bottom companies
score_data %>% filter(ticker %in% c(bottom_stock_data %>% pull(ticker) %>% unique()))

## # A tibble: 23 × 31
##     ...1 compa…¹ sector publi…² ticker `1995` `1996` `1997` `1998` `1999` `2000`
##    <dbl> <chr>   <chr>  <chr>   <chr>  <chr>  <chr>  <chr>  <chr>  <chr>  <chr> 
##  1    29 Everso… Inves… Yes     ES     70     72     67     65     68     72    
##  2    31 PG&E    Inves… Yes     PCG    71     72     71     68     71     73    
##  3    48 Optimu… Inter… Yes     ATUS                                            
##  4    50 Optimu… Fixed… Yes     ATUS   <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  5    55 Spirit  Airli… Yes     SAVE   <NA>   <NA>   <NA>   <NA>   <NA>   <NA>  
##  6    69 Sudden… Subsc… Yes     ATUS                        <NA>   <NA>   <NA>  
##  7   163 Xfinit… Video… Yes     CMCSA  <NA>   <NA>                              
##  8   164 Spectr… Video… Yes     CHTR   <NA>   <NA>                              
##  9   169 Micros… Video… Yes     MSFT   <NA>   <NA>                              
## 10   182 Merril… Finan… Yes     BAC                                             
## # … with 13 more rows, 20 more variables: `2001` <chr>, `2002` <chr>,
## #   `2003` <chr>, `2004` <chr>, `2005` <chr>, `2006` <chr>, `2007` <chr>,
## #   `2008` <chr>, `2009` <chr>, `2010` <chr>, `2011` <chr>, `2012` <chr>,
## #   `2013` <chr>, `2014` <chr>, `2015` <chr>, `2016` <chr>, `2017` <chr>,
## #   `2018` <chr>, `2019` <chr>, `2020` <chr>, and abbreviated variable names
## #   ¹​company_name, ²​publicly_traded

Create composite plot

grid.arrange(p1 +
  theme(legend.position = "none") + ggtitle("99th Percentile") + ylab(""), 
  p5 +
  theme(legend.position = "none") + ggtitle("95th Percentile") + ylab(""), 
  p10 +
  theme(legend.position = "none") + ggtitle("90th Percentile") + ylab(""), 
  p25 +
  theme(legend.position = "none") + ggtitle("75th Percentile") + ylab("")) 

## Warning: Removed 1 row containing missing values (`geom_line()`).

What does the curve look like for % picked and cumulative returns?

#function to extract cumulative performance each time
get_cumulative_performance <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  final_return

}

return_results <- c()

for (input_percentile in seq(from = 0.01, to = 0.99, by = 0.01)) {
  
  labeled_data <- label_data(score_data_long %>% drop_na(), input_percentile, 0.01)
  
  top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  
  stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))
  
  top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
  top_stock_data$type <- "Top 1% Companies (ACSI Score)"
  
  mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
  mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"
  
  bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
  bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"
  
  compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)
  
  # If you want to look across specific years
  #compiled_data %<>% filter(year %in% c("2017", "2018", "2019", "2020", "2021"))
  #compiled_data %<>% filter(year %in% c("2012", "2013", "2014", "2015", "2016"))
  #compiled_data %<>% filter(year %in% c("2007", "2008", "2009", "2010", "2011"))
  #compiled_data %<>% filter(year %in% c("2002", "2003", "2004", "2005", "2006"))
  #compiled_data %<>% filter(year %in% c("1997", "1998", "1999", "2000", "2001"))
  
  median_changes <- compiled_data %>%
    group_by(year, type) %>%
    summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 
  
  median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))
  
  
  
  
  
  return_results <- c(return_results, get_cumulative_performance(median_changes %>% drop_na()))
}

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 2867702.56
## Top 1% Companies (ACSI Score): 2767.7%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 1548038.6
## Top 1% Companies (ACSI Score): 1448.04%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 1096353.36
## Top 1% Companies (ACSI Score): 996.35%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 898167.54
## Top 1% Companies (ACSI Score): 798.17%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 884141.14
## Top 1% Companies (ACSI Score): 784.14%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 819815.59
## Top 1% Companies (ACSI Score): 719.82%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 579228.13
## Top 1% Companies (ACSI Score): 479.23%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 541040.52
## Top 1% Companies (ACSI Score): 441.04%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 481790.32
## Top 1% Companies (ACSI Score): 381.79%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 544378.51
## Top 1% Companies (ACSI Score): 444.38%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 887033.49
## Top 1% Companies (ACSI Score): 787.03%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 684862.53
## Top 1% Companies (ACSI Score): 584.86%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 677350.21
## Top 1% Companies (ACSI Score): 577.35%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 767588.28
## Top 1% Companies (ACSI Score): 667.59%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 750783
## Top 1% Companies (ACSI Score): 650.78%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 775814.65
## Top 1% Companies (ACSI Score): 675.81%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 832465.77
## Top 1% Companies (ACSI Score): 732.47%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 814269.04
## Top 1% Companies (ACSI Score): 714.27%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 537295.22
## Top 1% Companies (ACSI Score): 437.3%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 558472.24
## Top 1% Companies (ACSI Score): 458.47%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 520396.56
## Top 1% Companies (ACSI Score): 420.4%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 526481.04
## Top 1% Companies (ACSI Score): 426.48%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 553426.22
## Top 1% Companies (ACSI Score): 453.43%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 567965.88
## Top 1% Companies (ACSI Score): 467.97%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569096.3
## Top 1% Companies (ACSI Score): 469.1%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 592232.38
## Top 1% Companies (ACSI Score): 492.23%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 481934.41
## Top 1% Companies (ACSI Score): 381.93%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 472332.54
## Top 1% Companies (ACSI Score): 372.33%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 466116.54
## Top 1% Companies (ACSI Score): 366.12%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 472646.45
## Top 1% Companies (ACSI Score): 372.65%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 479159.41
## Top 1% Companies (ACSI Score): 379.16%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 488555.57
## Top 1% Companies (ACSI Score): 388.56%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 488441.11
## Top 1% Companies (ACSI Score): 388.44%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 490404.23
## Top 1% Companies (ACSI Score): 390.4%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 508667.01
## Top 1% Companies (ACSI Score): 408.67%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 502168.43
## Top 1% Companies (ACSI Score): 402.17%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 499674.96
## Top 1% Companies (ACSI Score): 399.67%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 534043.8
## Top 1% Companies (ACSI Score): 434.04%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 522850.2
## Top 1% Companies (ACSI Score): 422.85%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 522850.2
## Top 1% Companies (ACSI Score): 422.85%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 513625.57
## Top 1% Companies (ACSI Score): 413.63%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 515114.54
## Top 1% Companies (ACSI Score): 415.11%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 533191.71
## Top 1% Companies (ACSI Score): 433.19%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 534881.51
## Top 1% Companies (ACSI Score): 434.88%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 529972.16
## Top 1% Companies (ACSI Score): 429.97%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 541581.03
## Top 1% Companies (ACSI Score): 441.58%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 591371.84
## Top 1% Companies (ACSI Score): 491.37%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565968.59
## Top 1% Companies (ACSI Score): 465.97%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 560136.01
## Top 1% Companies (ACSI Score): 460.14%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 580476.92
## Top 1% Companies (ACSI Score): 480.48%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 597699.01
## Top 1% Companies (ACSI Score): 497.7%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 608023.58
## Top 1% Companies (ACSI Score): 508.02%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 608165.14
## Top 1% Companies (ACSI Score): 508.17%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 625140.71
## Top 1% Companies (ACSI Score): 525.14%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 615155.54
## Top 1% Companies (ACSI Score): 515.16%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 591033.65
## Top 1% Companies (ACSI Score): 491.03%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 585537.23
## Top 1% Companies (ACSI Score): 485.54%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 600817.67
## Top 1% Companies (ACSI Score): 500.82%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 573744.13
## Top 1% Companies (ACSI Score): 473.74%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 564923.45
## Top 1% Companies (ACSI Score): 464.92%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 592579.57
## Top 1% Companies (ACSI Score): 492.58%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566164.74
## Top 1% Companies (ACSI Score): 466.16%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570769.65
## Top 1% Companies (ACSI Score): 470.77%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 571609.38
## Top 1% Companies (ACSI Score): 471.61%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566136.87
## Top 1% Companies (ACSI Score): 466.14%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 571665.22
## Top 1% Companies (ACSI Score): 471.67%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 576305.74
## Top 1% Companies (ACSI Score): 476.31%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570148.88
## Top 1% Companies (ACSI Score): 470.15%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569631.9
## Top 1% Companies (ACSI Score): 469.63%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 547261.26
## Top 1% Companies (ACSI Score): 447.26%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 548209.94
## Top 1% Companies (ACSI Score): 448.21%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554631.63
## Top 1% Companies (ACSI Score): 454.63%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554979.33
## Top 1% Companies (ACSI Score): 454.98%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 555455.73
## Top 1% Companies (ACSI Score): 455.46%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 547210.13
## Top 1% Companies (ACSI Score): 447.21%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 548549.28
## Top 1% Companies (ACSI Score): 448.55%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 555858.55
## Top 1% Companies (ACSI Score): 455.86%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 540619.6
## Top 1% Companies (ACSI Score): 440.62%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 532801.5
## Top 1% Companies (ACSI Score): 432.8%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 538707.46
## Top 1% Companies (ACSI Score): 438.71%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 533476.01
## Top 1% Companies (ACSI Score): 433.48%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551239.89
## Top 1% Companies (ACSI Score): 451.24%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 561596.57
## Top 1% Companies (ACSI Score): 461.6%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 564088.6
## Top 1% Companies (ACSI Score): 464.09%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 563708.36
## Top 1% Companies (ACSI Score): 463.71%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565112.38
## Top 1% Companies (ACSI Score): 465.11%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 554779.46
## Top 1% Companies (ACSI Score): 454.78%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551784.06
## Top 1% Companies (ACSI Score): 451.78%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 567533.68
## Top 1% Companies (ACSI Score): 467.53%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 566263.94
## Top 1% Companies (ACSI Score): 466.26%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 574906.99
## Top 1% Companies (ACSI Score): 474.91%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 570026.43
## Top 1% Companies (ACSI Score): 470.03%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 569263.53
## Top 1% Companies (ACSI Score): 469.26%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 575759.02
## Top 1% Companies (ACSI Score): 475.76%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 565327.63
## Top 1% Companies (ACSI Score): 465.33%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 562019.18
## Top 1% Companies (ACSI Score): 462.02%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 551600.52
## Top 1% Companies (ACSI Score): 451.6%

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

## S&P 500: 821191.11
## S&P 500: 721.19%
## Top 1% Companies (ACSI Score): 553104.12
## Top 1% Companies (ACSI Score): 453.1%

return_results

##  [1] 3607.4073 2767.7026 1448.0386  996.3534  798.1675  784.1411  719.8156
##  [8]  479.2281  441.0405  381.7903  444.3785  787.0335  584.8625  577.3502
## [15]  667.5883  650.7830  675.8146  732.4658  714.2690  437.2952  458.4722
## [22]  420.3966  426.4810  453.4262  467.9659  469.0963  492.2324  381.9344
## [29]  372.3325  366.1165  372.6465  379.1594  388.5556  388.4411  390.4042
## [36]  408.6670  402.1684  399.6750  434.0438  422.8502  422.8502  413.6256
## [43]  415.1145  433.1917  434.8815  429.9722  441.5810  491.3718  465.9686
## [50]  460.1360  480.4769  497.6990  508.0236  508.1651  525.1407  515.1555
## [57]  491.0336  485.5372  500.8177  473.7441  464.9235  492.5796  466.1647
## [64]  470.7696  471.6094  466.1369  471.6652  476.3057  470.1489  469.6319
## [71]  447.2613  448.2099  454.6316  454.9793  455.4557  447.2101  448.5493
## [78]  455.8586  440.6196  432.8015  438.7075  433.4760  451.2399  461.5966
## [85]  464.0886  463.7084  465.1124  454.7795  451.7841  467.5337  466.2639
## [92]  474.9070  470.0264  469.2635  475.7590  465.3276  462.0192  451.6005
## [99]  453.1041

Plot the two

# Generate example data
x <- rev(seq(from = 0.01, to = 0.99, by = 0.01))
y <- return_results

# Combine x and y into a data frame
data <- data.frame(x, y)

# Create plot object
ggplot(data, aes(x=x, y=y)) + 

  # Add line layer
  geom_line(color="#1cb4b6") +
  
  # Add x and y axis labels
  xlab("ACSI Percentile") + ylab("Returns (%)") +
  
  # Add plot title
  ggtitle("") + theme_bw() + geom_hline(yintercept=114.96,linetype=2, color = "#f55c54") +
  geom_area(aes(fill=y), alpha = 0.2) + theme_classic() +
  theme(legend.position = "none") 

Does picking the top company in each sector in terms of consumer satisfaction beat the S&P 500?

# take the top one in each sector, needs to be slightly modified
label_data_sector <- function(df, top_cutoff, bottom_cutoff) {

  rows <- 2 # we want to filter out sectors with less than 2 companies in that year 
  
  df_labeled <- df %>% 
    group_by(year, sector) %>% 
    mutate(top_score = quantile(score, 1 - top_cutoff),
           bottom_score = quantile(score, bottom_cutoff),
           label = case_when(score >= top_score ~ "top",
                             score <= bottom_score ~ "bottom",
                             TRUE ~ "none")) %>% filter(n() >= rows) %>% 
    ungroup()
  
  return(df_labeled)
}

labeled_data <- label_data_sector(score_data_long %>% drop_na(), 0.01, 0.01) #take the companies in the 99th and 1st Percentiles

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top Company in Each Sector"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Other Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom Companies in Each Sector (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top Company in Each Sector", "Other Companies (ACSI Score)", "Bottom Companies in Each Sector (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

ps_data <- median_changes %>% drop_na()

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%

How many times was each strategy the highest performing?

count_highest_types(median_changes)

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          9                         17

count_highest_types(median_changes %>% filter(year %in% c("1997", "1998", "1999", "2000", "2001")))

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          2                          3

count_highest_types(median_changes %>% filter(year %in% c("2002", "2003", "2004", "2005", "2006")))

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4

count_highest_types(median_changes %>% filter(year %in% c("2007", "2008", "2009", "2010", "2011")))

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4

count_highest_types(median_changes %>% filter(year %in% c("2012", "2013", "2014", "2015", "2016")))

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          1                          4

count_highest_types(median_changes %>% filter(year %in% c("2017", "2018", "2019", "2020", "2021")))

## highest_types
##                    S&P 500 Top Company in Each Sector 
##                          3                          2

Picking the top company in each sector seems to do better than S&P500 and other strategies.

Does the trend break down after a certain year? After the results were published?

Top 1%

# Re-run logic from top and bottom 5% with altered parameters/labels....
labeled_data <- label_data(score_data_long %>% drop_na(), 0.01, 0.01)

top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top 1% Companies (ACSI Score)"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Mid 98% Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom 1% Companies (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

# Only look in recent years
#compiled_data %<>% filter(year %in% c("2014", "2015", "2016", "2017", "2018", "2019", "2020"))

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top 1% Companies (ACSI Score)", "Mid 98% Companies (ACSI Score)", "Bottom 1% Companies (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

p1 <- plot_cumulative_performance(median_changes %>% drop_na())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top 1% Companies (ACSI Score): 0.208808022053884+/-0.399131588164006"
## Top 1% Companies (ACSI Score): 3707407.25
## Top 1% Companies (ACSI Score): 3607.41%

p1

## Warning: Removed 1 row containing missing values (`geom_line()`).

top_1_percentile_data <- median_changes

ggplot(median_changes, aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")

## Warning: Removed 1 row containing missing values (`geom_line()`).

Top Company in Each Sector

labeled_data <- label_data_sector(score_data_long %>% drop_na(), 0.01, 0.01) #take the companies in the 99th and 1st Percentiles


top_ticker_year_pairs <- labeled_data %>% filter(label == "top") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

bottom_ticker_year_pairs <- labeled_data %>% filter(label == "bottom") %>%  mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

mid_ticker_year_pairs <- labeled_data %>% filter(label == "none") %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 

stock_data_long <- stock_data_long[order(stock_data_long$ticker, stock_data_long$year),] %>% mutate(ticker_year = paste0(ticker, "_", year))

top_stock_data <- stock_data_long %>% filter(ticker_year %in% top_ticker_year_pairs) %>% select(-ticker_year)
top_stock_data$type <- "Top Company in Each Sector"

mid_stock_data <- stock_data_long %>% filter(ticker_year %in% mid_ticker_year_pairs) %>% select(-ticker_year)
mid_stock_data$type <- "Other Companies (ACSI Score)"

bottom_stock_data <- stock_data_long %>% filter(ticker_year %in% bottom_ticker_year_pairs) %>% select(-ticker_year)
bottom_stock_data$type <- "Bottom Companies in Each Sector (ACSI Score)"

compiled_data <- stock_data_long %>% filter(ticker == "SPY") %>% full_join(top_stock_data) #%>% full_join(mid_stock_data) %>% full_join(bottom_stock_data)

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

# Only look in recent years
#compiled_data %<>% filter(year %in% c("2014", "2015", "2016", "2017", "2018", "2019", "2020"))

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

median_changes$type <- factor(median_changes$type, levels=c("S&P 500", "Top Company in Each Sector", "Other Companies (ACSI Score)", "Bottom Companies in Each Sector (ACSI Score)"))

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 1 rows containing missing values (`geom_col()`).

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%

Plot the performance per year

ggplot(median_changes, aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")

## Warning: Removed 1 row containing missing values (`geom_line()`).

Compare top company in each sector and top 1%

top_1_percentile_data %<>% filter(type != "S&P 500")
ggplot(median_changes %>% full_join(top_1_percentile_data), aes(x = year, y = median_change, color = type, group=type)) +
    geom_line(size = 1) +
    labs(x = "Year", y = "Change", title = "Annual Returns") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("") + geom_hline(yintercept=0,linetype=2, color = "grey")

## Joining, by = c("year", "type", "median_change")

## Warning: Removed 1 row containing missing values (`geom_line()`).

Does picking sectors with the highest satisfaction beat the S&P 500?

This needs to be expanded, we need to add logic that picks the sector with the highest scores. This is slightly derivative and not that different though…

# create the first one
compiled_data <- stock_data_long %>% filter(ticker == "SPY")


# go through each sector
for (sector_type in score_data_long$sector %>% unique()) {
  sector_ticker_year_pairs <- score_data_long %>% filter(sector == sector_type) %>% mutate(ticker_year = paste0(ticker, "_", as.numeric(year) + 1)) %>% pull(ticker_year) 
  select_stock_data <- stock_data_long %>% filter(ticker_year %in% sector_ticker_year_pairs) %>% select(-ticker_year)
select_stock_data$type <- sector_type

  

  # add it to the compiled data
  compiled_data %<>% full_join(select_stock_data)
  
}

## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")
## Joining, by = c("ticker", "year", "price", "type",
## "price_change_from_prev_year")

median_changes <- compiled_data %>%
  group_by(year, type) %>%
  summarize(median_change = median(price_change_from_prev_year, na.rm = TRUE)) 

## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.

sector_options <- c("S&P 500")
for (sector_name in score_data_long$sector %>% unique()) {
  sector_options <- c(sector_options, sector_name)
}
 
median_changes$type <- factor(median_changes$type, levels=sector_options)

# How similar is the median stock changes year to year with the S&P 500? (using as a benchmark)
ggplot(data = median_changes, aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

## Warning: Removed 7 rows containing missing values (`geom_col()`).

plot_cumulative_performance(median_changes %>% drop_na()) + xlab("")

## [1] "Airlines: 0.176687262136455+/-0.384515675069081"
## Airlines: 1656853.72
## Airlines: 1556.85%
## [1] "Apparel: 0.136751737906527+/-0.275032165754184"
## Apparel: 1167645.01
## Apparel: 1067.65%
## [1] "Athletic Shoes: 0.186755174111474+/-0.291068988375815"
## Athletic Shoes: 3369101.53
## Athletic Shoes: 3269.1%
## [1] "Automobiles and Light Vehicles: 0.0579756622901008+/-0.276870352427774"
## Automobiles and Light Vehicles: 189141.5
## Automobiles and Light Vehicles: 89.14%
## [1] "Banks: 0.105496148933519+/-0.221153974678497"
## Banks: 741862.55
## Banks: 641.86%
## [1] "Breweries: 0.136437956489888+/-0.281505010996068"
## Breweries: 1154508.91
## Breweries: 1054.51%
## [1] "Cellular Telephones: 0.267329122528215+/-1.0012549107222"
## Cellular Telephones: 1039851.85
## Cellular Telephones: 939.85%
## [1] "Computer Software: 0.231747073212364+/-0.398500986767627"
## Computer Software: 4130861.76
## Computer Software: 4030.86%
## [1] "Consumer Shipping: 0.121830587930321+/-0.214498474144428"
## Consumer Shipping: 1236643.9
## Consumer Shipping: 1136.64%
## [1] "Department and Discount Stores: 0.116734163408508+/-0.230649385388318"
## Department and Discount Stores: 920319.45
## Department and Discount Stores: 820.32%
## [1] "Financial Advisors: 0.115677429428235+/-0.27226345182076"
## Financial Advisors: 668067.57
## Financial Advisors: 568.07%
## [1] "Fixed-Line Telephone Service: 0.0680750197102281+/-0.223339239061943"
## Fixed-Line Telephone Service: 312220.69
## Fixed-Line Telephone Service: 212.22%
## [1] "Food Manufacturing: 0.0734286764151807+/-0.164889351938863"
## Food Manufacturing: 432929.82
## Food Manufacturing: 332.93%
## [1] "Full-Service Restaurants: 0.149887040196856+/-0.202385685587937"
## Full-Service Restaurants: 2223987.13
## Full-Service Restaurants: 2123.99%
## [1] "Gasoline Stations: 0.150252775767991+/-0.102480256052002"
## Gasoline Stations: 226886.66
## Gasoline Stations: 126.89%
## [1] "Health and Personal Care Stores: 0.136534115013567+/-0.267460323868653"
## Health and Personal Care Stores: 1249864.95
## Health and Personal Care Stores: 1149.86%
## [1] "Health Insurance: 0.184622800007245+/-0.244099749461849"
## Health Insurance: 4041769.98
## Health Insurance: 3941.77%
## [1] "Household Appliances: 0.137468362026771+/-0.399684501585797"
## Household Appliances: 554362.44
## Household Appliances: 454.36%
## [1] "Internet Investment Services: 0.207348054157065+/-0.398047093706746"
## Internet Investment Services: 2793326.27
## Internet Investment Services: 2693.33%
## [1] "Internet News and Opinion: 0.0618804720360484+/-0.292991028920415"
## Internet News and Opinion: 163809.43
## Internet News and Opinion: 63.81%
## [1] "Internet Retail: 0.225548711238225+/-0.436299274383031"
## Internet Retail: 2772734.79
## Internet Retail: 2672.73%
## [1] "Internet Service Providers: 0.194899431457417+/-0.350757677912917"
## Internet Service Providers: 2918580.54
## Internet Service Providers: 2818.58%
## [1] "Internet Social Media: 0.368285679270924+/-0.424870466375406"
## Internet Social Media: 14041285.15
## Internet Social Media: 13941.29%
## [1] "Investor-Owned Energy Utilities: 0.0746571011397432+/-0.151424274304235"
## Investor-Owned Energy Utilities: 499755.76
## Investor-Owned Energy Utilities: 399.76%
## [1] "Limited-Service Restaurants: 0.139248040308854+/-0.224435710661761"
## Limited-Service Restaurants: 1403059.77
## Limited-Service Restaurants: 1303.06%
## [1] "Motion Pictures: 0.210662898887278+/-NA"
## Motion Pictures: 121066.29
## Motion Pictures: 21.07%
## [1] "Network/Cable TV News: 0.285326058516712+/-NA"
## Network/Cable TV News: 128532.61
## Network/Cable TV News: 28.53%
## [1] "Newspapers: 0.335227272727273+/-NA"
## Newspapers: 133522.73
## Newspapers: 33.52%
## [1] "Personal Care and Cleaning Products: 0.103020559662606+/-0.147928153101665"
## Personal Care and Cleaning Products: 940638.1
## Personal Care and Cleaning Products: 840.64%
## [1] "Personal Computers: 0.24556934674859+/-0.46606725696862"
## Personal Computers: 4024618.15
## Personal Computers: 3924.62%
## [1] "Pet Food: 0.123394358531076+/-0.169259972443039"
## Pet Food: 1420572.16
## Pet Food: 1320.57%
## [1] "Property and Casualty Insurance: 0.137813879015737+/-0.299734916672751"
## Property and Casualty Insurance: 1081707.93
## Property and Casualty Insurance: 981.71%
## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "Soft Drinks: 0.086209240232677+/-0.160789963782022"
## Soft Drinks: 601618.49
## Soft Drinks: 501.62%
## [1] "Specialty Retail Stores: 0.1514599144648+/-0.326061086490932"
## Specialty Retail Stores: 1313169.39
## Specialty Retail Stores: 1213.17%
## [1] "Subscription Television: 0.0867734551897014+/-0.209771527749837"
## Subscription Television: 252342.11
## Subscription Television: 152.34%
## [1] "Subscription Television Service: 0.287465437453642+/-0.77791918763654"
## Subscription Television Service: 4221991.43
## Subscription Television Service: 4121.99%
## [1] "Supermarkets: 0.120187577528246+/-0.253167299132231"
## Supermarkets: 915594.39
## Supermarkets: 815.59%
## [1] "Televisions and Video Players: 0.249219508111845+/-0.0800664106961531"
## Televisions and Video Players: 155734.41
## Televisions and Video Players: 55.73%
## [1] "Wireless Telephone Service: 0.0635466403074176+/-0.24121337236302"
## Wireless Telephone Service: 252835.91
## Wireless Telephone Service: 152.84%
## [1] "Life Insurance: 0.109559525292321+/-0.292101190520864"
## Life Insurance: 576866.98
## Life Insurance: 476.87%
## [1] "Video Streaming Service: 0.518883844333666+/-1.20684217613686"
## Video Streaming Service: 24750756.72
## Video Streaming Service: 24650.76%
## [1] "Video-on-Demand Service: 0.147168069855939+/-0.314210573426174"
## Video-on-Demand Service: 1022882.69
## Video-on-Demand Service: 922.88%
## [1] "Hotels: 0.103071160911382+/-0.259202266792263"
## Hotels: 450061.31
## Hotels: 350.06%
## [1] "Internet Search Engines and Information: 0.30740390641944+/-0.452377556475301"
## Internet Search Engines and Information: 2694122.8
## Internet Search Engines and Information: 2594.12%
## [1] "Internet Travel Services: 0.199693159397023+/-0.706537401755926"
## Internet Travel Services: 162381.55
## Internet Travel Services: 62.38%
## [1] "Cigarettes: 0.122781261704128+/-0.177031115754438"
## Cigarettes: 169399.99
## Cigarettes: 69.4%
## [1] "Personal Computers and Household Appliances: 0.194311327111837+/-0.317141426059297"
## Personal Computers and Household Appliances: 207089.55
## Personal Computers and Household Appliances: 107.09%
## [1] "Personal Computers and Internet Retail: 0.466128520017841+/-0.382751890940777"
## Personal Computers and Internet Retail: 599846.45
## Personal Computers and Internet Retail: 499.85%
## [1] "Internet Service Providers/Fixed-Line Phone: 0.0457617887949242+/-0.570116117412604"
## Internet Service Providers/Fixed-Line Phone: 87310.13
## Internet Service Providers/Fixed-Line Phone: -12.69%

## Warning: Removed 24 rows containing missing values (`geom_line()`).

Create cumulative plot for all strategies

We need to make a slightly bigger one to handle the large (4M increase)

plot_cumulative_performance_modified <- function(df) {
  
  starting_amount <- 100000
  # Calculate cumulative performance for each trading strategy
  df_cumulative <- df %>%
    group_by(type) %>%
    arrange(year) %>%
    mutate(cumulative_return = cumprod(1 + median_change) * starting_amount)
  
  # Loop through all possible types in df_cumulative and print the final cumulative return
  for (t in unique(df_cumulative$type)) {
    #get the standard deviation in returns
    annual_mean_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% mean()
    annual_sd_return <- df %>% filter(type == t) %>% drop_na() %>% pull(median_change) %>% sd()
    print(paste0(t, ": ", annual_mean_return, "+/-", annual_sd_return))

    final_return <- df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return)
    cat(paste0(t, ": ", round(final_return, 2), "\n"))
    final_return <- (df_cumulative %>% filter(type == t) %>% filter(year == max(year)) %>% pull(cumulative_return) / starting_amount - 1) * 100
    cat(paste0(t, ": ", round(final_return, 2), "%\n"))
  }
  
  # Plot cumulative performance for each trading strategy
  ggplot(df_cumulative, aes(x = year, y = cumulative_return, color = type, group=type)) +
    geom_line(size=1) +
    scale_y_continuous(labels = scales::dollar, limits=c(0,4000000)) +
    labs(x = "Year", y = "Portfolio Balance", title = "Cumulative Performance") +
    theme_classic() +
    guides(color=guide_legend(title="Group")) +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
    theme(legend.position = "right", legend.title=element_blank()) +
    theme(plot.title = element_text(face="bold")) +
    xlab("")
  
}

all_strategy_data <- p1_data %>% full_join(p5_data) %>% full_join(p10_data) %>% full_join(p25_data) %>% full_join(ps_data) %>% full_join(acsi_total_data) %>% distinct()

## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")
## Joining, by = c("year", "type", "median_change")

all_strategy_data %<>% mutate(type = case_when(
  type == "S&P 500" ~ "S&P 500",
  type == "Top 1% Companies (ACSI Score)" ~ "99th Percentile Across All Sectors",
  type == "Top 5% Companies (ACSI Score)" ~ "95th Percentile Across All Sectors",
  type == "Top 10% Companies (ACSI Score)" ~ "10th Percentile Across All Sectors",
  type == "Top 25% Companies (ACSI Score)" ~ "75th Percentile Across All Sectors",
  type == "Top Company in Each Sector" ~ "Top Company in Each Sector",
  type == "ACSI Surveyed Companies" ~ "All Publicly Traded Companies w/ ACSI Data",
))

all_strategy_data %<>% drop_na()

all_strategy_data$type <- factor(all_strategy_data$type, levels=c("Top Company in Each Sector", "99th Percentile Across All Sectors", "95th Percentile Across All Sectors", "90th Percentile Across All Sectors", "75th Percentile Across All Sectors", "All Publicly Traded Companies w/ ACSI Data", "S&P 500"))

cp1 <- plot_cumulative_performance_modified(all_strategy_data %>% drop_na()) + xlab("") + theme_bw() + theme(legend.position = "none", legend.title=element_blank())

## [1] "S&P 500: 0.100287853378119+/-0.178202622639399"
## S&P 500: 821191.11
## S&P 500: 721.19%
## [1] "99th Percentile Across All Sectors: 0.208808022053884+/-0.399131588164006"
## 99th Percentile Across All Sectors: 3707407.25
## 99th Percentile Across All Sectors: 3607.41%
## [1] "95th Percentile Across All Sectors: 0.100672606229892+/-0.162447844477771"
## 95th Percentile Across All Sectors: 898167.54
## 95th Percentile Across All Sectors: 798.17%
## [1] "75th Percentile Across All Sectors: 0.0805406108563645+/-0.157748573704633"
## 75th Percentile Across All Sectors: 567965.88
## 75th Percentile Across All Sectors: 467.97%
## [1] "Top Company in Each Sector: 0.114663112249387+/-0.148336429241189"
## Top Company in Each Sector: 1317441.4
## Top Company in Each Sector: 1217.44%
## [1] "All Publicly Traded Companies w/ ACSI Data: 0.0972256498177776+/-0.151010517168814"
## All Publicly Traded Companies w/ ACSI Data: 860506.02
## All Publicly Traded Companies w/ ACSI Data: 760.51%

df <- all_strategy_data

sp500_median <- df %>%
  filter(type == "S&P 500") %>%
  select(year, sp500_median_change = median_change)

# Join the original dataframe with the S&P 500 median changes
df <- df %>%
  left_join(sp500_median, by = "year") %>%
  mutate(median_change = median_change - sp500_median_change) %>%
  select(-sp500_median_change)


cp2 <- ggplot(data = df %>% drop_na(), aes(x = year, y = median_change, fill = type)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.8) +
  labs(title = "Change in Stock Price by Year and Type", x = "Year", y = "Price Change vs. S&P 500", fill = "Type") +
  theme(plot.title = element_text(hjust = 0.5))  +
  guides(fill = guide_legend(ncol = 2)) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  theme(legend.position = "top", legend.title=element_blank()) + xlab("")

grid.arrange(cp2 + ggtitle(""), cp1 + ggtitle(""))

Create plot of performance of the core strategies over 5 year intervals in terms of beating the S&P 500

data <- data.frame(
  Strategy = c("95th Percentile Across All Sectors", "90th Percentile Across All Sectors",
               "75th Percentile Across All Sectors", "99th Percentile Across All Sectors",
               "Top Company in Each Sector"),
  `1997 - 2001` = c(0.4, 0.4, 0.4, 0.4, 0.6),
  `2002 - 2006` = c(0.8, 0.8, 0.6, 1, 0.8),
  `2007 - 2011` = c(0.8, 0.6, 0, 0.6, 0.8),
  `2012 - 2016` = c(0.2, 0.2, 0.4, 0.4, 0.8),
  `2017 - 2021` = c(0.2, 0, 0, 0.2, 0.4)
)
data$Strategy <- factor(data$Strategy, levels=c("Top Company in Each Sector", "99th Percentile Across All Sectors", "95th Percentile Across All Sectors", "90th Percentile Across All Sectors", "75th Percentile Across All Sectors"))

data_long <- gather(data, key = "Period", value = "Value", -Strategy)

# rename x_labels since they are currently formatted as X1997-2001, X2002...
x_labels <- c("1997 - 2001", "2002 - 2006", "2007 - 2011", "2012 - 2016", "2017 - 2021")

ggplot(data_long, aes(x = Period, y = Value, group = Strategy, color = Strategy)) +
  geom_line(size= 1) +
  labs(x = "Period", y = "Proportion of Years Beating the S&P 500") + theme_bw() + xlab("Five Year Period") +
  scale_x_discrete(labels = x_labels)